{***************************************************************************
*   zCodeEditor
*   -------------------
*   begin    : Friday, Mo, 12. November, 2007
*   copyright: (C) 2007 Daniel Ackermann
*   website  : www.zerolith.com
*
*   License:
*   --------
*   This program is free software: you can redistribute it and/or modify
*   it under the terms of the GNU General Public License as published by
*   the Free Software Foundation, either version 3 of the License, or
*   (at your option) any later version.
*
*   This program is distributed in the hope that it will be useful,
*   but WITHOUT ANY WARRANTY; without even the implied warranty of
*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
*   GNU General Public License for more details.
*
*   You should have received a copy of the GNU General Public License
*   along with this program.  If not, see <http://www.gnu.org/licenses/>.
*
*   Project:
*   --------
*   revision        : $Rev: 14 $
*   google-code site: http://tcodeeditor.googlecode.com/
***************************************************************************}

unit zCodeEditor;

interface

uses
  Classes, Controls, zDrawControl, ExtCtrls, Messages, Windows, Math, SysUtils,
  ceGlobal, ceConsts, zDrawFuns, ceCommon, Graphics;

const
  VERSION = '$Rev: 14 $';
  
  X_COLOR = $1E1E21;
  X_SELCOLOR = $FF0000;
  X_LEFT = $FFEDE9EB;
  X_WHEEL = 3;
  MARGIN = 5;

type
  TzCodeEditor = class(TzDrawControl)
  protected
    procedure Draw; override;
    procedure DrawIt(Canvas: TCanvas);
    procedure Resize; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure _KeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure _KeyUp(var Message: TWMKeyUp); message CN_KEYUP;
    procedure _WMMouseWheel(var Msg: TWMMouseWheel); message CM_MOUSEWHEEL;
    procedure _WMChar(var Message: TWMChar); message CN_CHAR;
  private
    fBmp: TBitmap;
    txt_height: longword;
    txt_width: longword;
    left_width: longword;
    fStyles: TzCodeEditorStyles;
    fText: widestring;
    fLines: TzLines;
    fRedraw: boolean;
    fActiveRow: longword;
    fScrollY: longword;
    fCursorState: boolean;
    fCursorTimer: TTimer;
    fCursorX, fCursorY: integer;
    fDown: boolean;
    fSelStart, fSelEnd: TPoint;
    fParser: TzParser;
    function FindTextPos: longword;
    function GetLeftWidth: longword;
    procedure ReposCursor(X, Y: longword);
    procedure DoTimer(Sender: TObject);
    procedure SetActiveRow(const Value: longword);
    procedure SetText(const Value: widestring);
    procedure SetStyles(const Value: TzCodeEditorStyles);
    procedure RedrawIt;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure InitParser(aFile: string);
  published
    property ActiveRow: longword read fActiveRow write SetActiveRow;
    property EditorStyle: TzCodeEditorStyles read fStyles write SetStyles;
    property Text: widestring read fText write SetText;
    property Anchors;
    property Visible;
    property Font;
    property TabStop;
    property TabOrder;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('zIDE', [TzCodeEditor]);
end;

{ TzCodeEditor }

procedure TzCodeEditor.Clear;
begin
  SetText('');
end;

constructor TzCodeEditor.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := true;
  ParentColor := false;
  fParser := nil;
  fCursorTimer := TTimer.Create(Self);
  fCursorTimer.Interval := 500;
  fCursorTimer.Enabled := true;
  fCursorTimer.OnTimer := DoTimer;
  fActiveRow := 0;
  fCursorX := 0;
  Cursor := crIBeam;
  fCursorY := 0;
  fScrollY := 0;
  fLines := TzLines.Create;
  Text := '';
  Color := $EFFFFF;
  TabStop := true;
  Font.Name := 'Tahoma';
  Font.Size := 8;
  Font.Style := [];
  Width := 200;
  Height := 160;

  fBmp := TBitmap.Create;
  fBmp.Width := Width;
  fBmp.Height := Height;
  with fBmp.Canvas do
  begin
    Font.Name := 'Courier New';
    Font.Size := 10;
  end;
end;

destructor TzCodeEditor.Destroy;
begin
  fLines.Free;
  inherited;
end;

procedure TzCodeEditor.Draw;
begin
  FTimer.Enabled := false;
  inherited;
  if not Assigned(fBmp) then Exit;
  
  if fRedraw then
  begin
    DrawIt(fBmp.Canvas);
    fRedraw := false;
  end;
  BitBlt(FSave.Canvas.Handle, 0,0, Width, Height, fbmp.Canvas.Handle, 0, 0, SRCCOPY);
  FTimer.Enabled := true;
  Paint;
end;

procedure TzCodeEditor.DoTimer(Sender: TObject);
begin
  fCursorState := not fCursorState;
  RedrawIt;
end;

function TzCodeEditor.GetLeftWidth: longword;
begin
  Result := Canvas.TextWidth(IntToStr(fLines.Lines)) + 15;
end;

procedure TzCodeEditor.InitParser(aFile: string);
begin
  if FileExists(aFile) then
  begin
    fParser := TzParser.Create(aFile);
    fParser.Output := fLines;
  end;
end;

procedure TzCodeEditor.DrawIt(Canvas: TCanvas);

  procedure DrawLeftBar;
  var
    i: longword;
    j, k: longword;
    s: string;
  begin
    with Canvas do
    begin
      Brush.Color := clBlack;
      Pen.Color := clBlack;
      FillRect(Rect(0, 0, left_width, Height));

      Brush.Color := clWhite;
      Pen.Color := clWhite;
      FillRect(Rect(0, 2, left_width - 1, Height));
      
      k := txt_height;
      j := Height div k;
      if j < 1 then Exit;
      
      for i := 0 to j - 1 do
      begin
        s := IntToStr(fScrollY + i + 1);
        if (fScrollY + i + 1) <= fLines.Lines then
        begin
          Font.Color := clDkGray;
          TextOutW(Canvas.Handle, Point(left_width - 5 - TextWidth(s), MARGIN + i * k), s);
        end;
      end;
    end;
  end;

  procedure DrawSelection;
  var
    h, w: longword;
    r: TRect;
    i: longword;
    sx, sy: longword;
    ex, ey: longword;
  begin
    with Canvas do
    begin
      h := txt_height;
      w := txt_width;

      sx := Min(fSelStart.X, fSelEnd.X);
      sy := Min(fSelStart.Y, fSelEnd.Y);

      ex := Max(fSelStart.X, fSelEnd.X);
      ey := Max(fSelStart.Y, fSelEnd.Y);

      ey := ey - fScrollY;
      sy := sy - fScrollY;

      if (sx = ex) then Exit;

      r.Left := left_width + MARGIN + (sx * w);
      r.Top := MARGIN + (sy * h);
      r.Bottom := MARGIN + ((sy + 1) * h);
      if ey = sy then
      begin
        r.Right := left_width + MARGIN + (ex * w);
        Brush.Color := X_SELCOLOR;
        Pen.Color := X_SELCOLOR;
        FillRect(r);
      end else
      begin
        r.Right := Width;
        Brush.Color := X_SELCOLOR;
        Pen.Color := X_SELCOLOR;
        FillRect(r);
        i := ey - sy;
        if i > 1 then
          while (i > 1) do
          begin
            r.Left := left_width + MARGIN;
            r.Right := Width;
            r.Top := r.Top + h;
            r.Bottom := r.Bottom + h;
            FillRect(r);
            dec(i);
          end;

        if i = 1 then
        begin
          r.Left := left_width + MARGIN;
          r.Right := left_width + MARGIN + (ex * w);
          r.Top := r.Top + h;
          r.Bottom := r.Bottom + h;
          FillRect(r);
        end;
      end;
    end;
  end;

  procedure DrawText;
  var
    i: longword;
    l, c, x, y, h: longword;
    aStart, aEnd: longword;
  begin
    l := 0;
    c := 0;
    x := left_width + MARGIN;
    y := MARGIN;
    with Canvas do
    begin
      h := txt_height;
      y := y - (fScrollY * h);

      aStart := fScrollY;
      aEnd := (Height - MARGIN) div h;
      aEnd := aEnd + aStart;

      Brush.Style := bsClear;
      
      for i := 1 to fLines.Count do
      begin
        if fLines[i]^.Value = NEWLINE then
        begin
          inc(l);
          c := 0;
        end else
          if fLines[i]^.Value = SPACE then inc(c)
          else begin
            if (l < aStart) then Continue;
            if (l > aEnd + fScrollY) then Exit;
            if fLines[i]^.Bold then
              Font.Style := [fsBold]
            else
              Font.Style := [];
            if not ((l < aStart) or (l > aEnd + fScrollY)) then
            begin
              Font.Color := fLines[i]^.Color;
              TextOutW(Canvas.Handle, Point(x + txt_width * c, y + l * h), fLines[i]^.Value);
            end;
            inc(c, Length(fLines[i]^.Value));
          end;
      end;
    end;
  end;

  procedure DrawCursor;
  var
    x, y, h, w: longword;
  begin
    if not fCursorState then Exit;
    with Canvas do
    begin
      h := txt_height;
      w := txt_width;
      x := left_width + MARGIN;
      y := MARGIN;
      Pen.Color := clWhite;
      MoveTo(x + ((fCursorX) * w) - 1, y + ((fCursorY - fScrollY) * h));
      LineTo(x + ((fCursorX) * w) - 1, y + h + ((fCursorY - fScrollY) * h));
    end;
  end;

begin
  with Canvas do
  begin

    Brush.Color := clBlack;
    Pen.Color := clBlack;
    FillRect(Canvas.ClipRect);

    Brush.Color := X_COLOR;
    Pen.Color := X_COLOR;
    FillRect(Rect(2, 2, Width, Height));

    if txt_height = 0 then
    begin
      txt_height := TextHeight('A');
      txt_width := TextWidth('A');
      left_width := GetLeftWidth;
    end;
    DrawLeftBar;
    DrawSelection;
    DrawText;
    if not (csDesigning in ComponentState) then DrawCursor;
  end;
end;

function TzCodeEditor.FindTextPos: longword;
var
  x, y: integer;
begin
  x := 0;
  y := 0;
  Result := 0;
  if Length(fText) = 0 then Exit;

  for Result := 1 to Length(fText) do
  begin
    if (x = fCursorX) and (y = fCursorY) then Exit;
    if fText[Result] = #13 then
    begin
      inc(y);
      x := 0;
      Continue;
    end else if fText[Result] = #10 then
      Continue
    else inc(x);
    if (x = fCursorX) and (y = fCursorY) then Exit;
  end;
  Result := 0;
end;

procedure TzCodeEditor._WMChar(var Message: TWMChar);
var
  i, j: longword;
  w: widechar;
  s: widestring;
begin
  i := GetKeyboardLayout(0) shr $10;
  case i of
    1033: w := WideChar(Message.CharCode); // English
    1031, 1034: w := Win1252ToWideChar(Char(Message.CharCode)); // German, Spain
    1049: w := Win1251ToWideChar(Char(Message.CharCode)); // Russian
    1051, 61447: w := Win1250ToWideChar(Char(Message.CharCode)); // Slovak, Polish
    61479: w := Win1257ToWideChar(Char(Message.CharCode)); // Baltic
  else
    w := WideChar(Message.CharCode);
  end;
  
  if (Message.CharCode < 30) and not (Message.CharCode = 13) and not (Message.CharCode = VK_SPACE) then exit;

  i := FindTextPos;
  inc(i);
  if w = #13 then
  begin
    s := #13#10;
    inc(fCursorY);
    j := (Height - MARGIN) div txt_height;
    if fCursorY > ((fScrollY + j) -1) then
      inc(fScrollY);
    fCursorX := 0;
  end else
  begin
    s := w;
    inc(fCursorX);
  end;
  Insert(s, fText, i);
  SetText(fText);
  RedrawIt;
end;

procedure TzCodeEditor._WMMouseWheel(var Msg: TWMMouseWheel);
begin
  if Msg.WheelDelta > 0 then
  begin
    if fScrollY > 0 then
    begin
      Dec(fScrollY, X_WHEEL);
      if fCursorY > fScrollY then
        fCursorY := fScrollY;
    end;
  end else
  begin
    if (fScrollY + ((MARGIN + Height) div txt_height)) < fLines.Lines then
      Inc(fScrollY, X_WHEEL);
    if fCursorY + 1 < fScrollY then
      fCursorY := fScrollY;
  end;
  RedrawIt;
end;

procedure TzCodeEditor._KeyDown(var Message: TWMKeyDown);
var
  h, s: longword;
  b, c: boolean;
begin
  fCursorTimer.Enabled := false;
  fCursorState := true;
  s := 1;
  case Message.CharCode of
    VK_BACK:
      begin
        h := FindTextPos;
        if h > 0 then
        begin
          b := fText[h] = #10;
          c := fText[h] = #13;
          Delete(fText, h, 1);
          if b then
            Delete(fText, h-1, 1);
          if b or c then
          begin
            Message.CharCode := VK_UP;
            _KeyDown(Message);
          end;
          SetText(fText);
        end;
        if fCursorX > 0 then
          Dec(fCursorX);
      end;
    VK_DELETE:
      begin
        h := FindTextPos;
        b := fText[h+1] = #13;
        Delete(fText, h + 1, 1);
        if b then
          Delete(fText, h+1,1);
        SetText(fText);
      end;
    VK_RETURN:
      begin
        inherited;
      end;
    VK_RIGHT: Inc(fCursorX);
    VK_LEFT:
      begin
        if fCursorX > 0 then
          Dec(fCursorX);
      end;
    VK_UP, VK_PRIOR:
      begin
        h := (Height - MARGIN) div txt_height;
        if fCursorY = 0 then Exit;

        if Message.CharCode = VK_PRIOR then
          s := h;
        if (fScrollY > 0) and ((fCursorY - s) < fScrollY) then
        begin
          s := Min(fScrollY, s);
          Dec(fScrollY, s);
        end;
        if fCursorY > 0 then
        begin
          s := Min(fCursorY, s);
          Dec(fCursorY, s);
        end;
      end;
    VK_DOWN, VK_NEXT:
      begin
        if fCursorY + 1 = fLines.Lines then Exit;
        h := (Height - MARGIN) div txt_height;
        if Message.CharCode = VK_NEXT then
          s := h;
        if (fCursorY + s) >= (fScrollY + h) then
          inc(fScrollY, s);
        Inc(fCursorY, s);
      end;
  else
    begin
      inherited;
      Exit;
    end;
  end;
  RedrawIt;
end;

procedure TzCodeEditor._KeyUp(var Message: TWMKeyUp);
begin
  fCursorTimer.Enabled := true;
end;

procedure TzCodeEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReposCursor(X, Y);
  fSelStart.X := fCursorX;
  fSelStart.Y := fCursorY;
  fSelEnd.X := fCursorX;
  fSelEnd.Y := fCursorY;
  fDown := true;
end;

procedure TzCodeEditor.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if fDown then
  begin
    ReposCursor(X, Y);
    fSelEnd.X := fCursorX;
    fSelEnd.Y := fCursorY;
    RedrawIt;
  end;
end;

procedure TzCodeEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReposCursor(X, Y);
  fDown := false;
  fSelEnd.X := fCursorX;
  fSelEnd.Y := fCursorY;
  RedrawIt;
end;

procedure TzCodeEditor.SetActiveRow(const Value: longword);
begin
  fActiveRow := Value;
end;

procedure TzCodeEditor.SetStyles(const Value: TzCodeEditorStyles);
begin
  fStyles := Value;
end;

procedure TzCodeEditor.SetText(const Value: widestring);
begin
//  fParser.Input := Value;
  RedrawIt;
end;

procedure TzCodeEditor.RedrawIt;
begin
  fRedraw := true;
end;

procedure TzCodeEditor.ReposCursor(X, Y: longword);
var
  h: longword;
  i: integer;
begin
  h := txt_height;
  fCursorY := fScrollY + (Y - MARGIN) div h;
  fCursorY := Min(fCursorY, fLines.Lines - 1);
  h := txt_width;
  i := (X - MARGIN - left_width) div h;
  fCursorX := Max(0, i);
end;

procedure TzCodeEditor.Resize;
begin
  inherited;
  fBmp.Width := Width;
  fBmp.Height := Height;
end;

end.
